home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / menus / toadmenu.zip / MENUTIL.INC < prev    next >
Text File  |  1987-10-30  |  7KB  |  206 lines
  1. {MENUTIL.INC}
  2. (*
  3.   Copyright (C)  David P Kirschbaum  All Rights Reserved
  4. *)
  5.  
  6. PROCEDURE RvsOn;
  7.   {Turn reverse video on}
  8.   BEGIN
  9.     TextColor(0);
  10.     TextBackGround(7);
  11.   END;
  12.  
  13. PROCEDURE RvsOff;
  14.   {Turn reverse video off}
  15.   BEGIN
  16.     TextColor(7);
  17.     TextBackGround(0);
  18.   END;
  19.  
  20.  
  21. PROCEDURE Cursor (state : curs_cond);
  22.   {Toggle cursor on or off}
  23.   BEGIN
  24.     WITH Regs DO BEGIN
  25.       ax := $0100;                      {BIOS request to set cursor}
  26.       CASE state OF
  27.         on  : IF Color THEN cx := $0607
  28.               ELSE cx :=  $0C0D;        { SET DEFAULT CURSOR TYPE }
  29.         off : cx := $2000;              { SET CURSOR OFF }
  30.       END;
  31.     END;
  32.     Intr($10,Regs);                     {CALL VIDEO INTERUPT}
  33.   END;  {of Cursor}
  34.  
  35.  
  36. FUNCTION Replicate (count : INTEGER; Ascii : CHAR ) : Str80;
  37.   { Replicate Ascii count times, return as a string.}
  38.   VAR  TStr : Str80;
  39.   BEGIN
  40.     FillChar(TStr[1],count,Ascii);     {fill with char}
  41.     TStr[0] := CHR(count);             {force length}
  42.     Replicate := TStr;                 {return string}
  43.   END;  {of Replicate}
  44.  
  45.  
  46. FUNCTION Centered (field_width : Byte; CenterStr : Str80 ) : Str80;            {* RETURN THE STRING         *
  47.  
  48. { Centers CentrStr in a field field_width spaces long (by padding
  49.   left with spaces, returns that string.  Does NOT pad to right.
  50. }
  51.   VAR
  52.     TStr   : Str80;
  53.     middle : Byte;
  54.     len : INTEGER;
  55.   BEGIN
  56.     middle := field_width SHR 1;
  57.     len := LENGTH(CenterStr);
  58.     IF len > field_width
  59.     THEN Centered := COPY(CenterStr,1,field_width) {truncate and return}
  60.     ELSE BEGIN
  61.       len := len SHR 1;
  62.       TStr := Replicate(middle - len,' ')
  63.               + CenterStr
  64.               + Replicate(SUCC(middle - len),' ');
  65.       Centered := COPY(TStr, 1, field_width)  {truncate to field_width chars}
  66.       END;
  67.    END;  {of Centered}
  68.  
  69.  
  70. {BOX.INC, downloaded from Delaware OPUS 27 Feb 87
  71.  Toad Hall
  72. }
  73.  
  74. TYPE line = (single,double,hdouble,vdouble,nongraphic,blank);
  75.  
  76. FUNCTION screen_location: INTEGER;
  77.   BEGIN
  78.     IF MEM[$0000:$0449] = 7
  79.     THEN BEGIN
  80.       screen_location := $B000;
  81.       Color := FALSE;
  82.     END
  83.     ELSE BEGIN
  84.       screen_location :=  $B800;
  85.       Color := TRUE;
  86.     END;
  87.   END;  {of screenLocation}
  88.  
  89.  
  90. PROCEDURE Box(x1,y1,x2,y2,color: INTEGER; linetype: line);
  91.  
  92. (***************************************************************************
  93.  
  94.   This procedure Draws a box with coordinates x1,y1 and x2,y2 being the
  95.   top left and bottom right corners of the box respectively.
  96.  
  97.   To print a box surrounding the entire screen using red double lines
  98.   The calling procedure is:      BOX( 1, 1, 80, 25, RED, double);
  99.  
  100.   Note:
  101.   This procedure will only run on IBM PC/XT/AT's & hardware compatibles.
  102.   Prior to calling this procedure, two variables need to be set up in
  103.   your program, these consist of:
  104.  
  105.       TYPE
  106.         X_SCRN_TYPE = ARRAY[1..2000] OF INTEGER;
  107.         Y_SCRN_TYPE = ARRAY[1..25,1..80] OF INTEGER;
  108.  
  109.       VAR
  110.         x_scrn: ^X_SCRN_TYPE;
  111.         y_scrn: ^Y_SCRN_TYPE;
  112.  
  113.   You should notice that the two variables defined are actually pointer
  114.   types, and should thus be pointing to the screen area of the machine.
  115.   This can be accomplished by a simple function call as follows:
  116.  
  117.        FUNCTION SCREENLOCATION: INTEGER;
  118.        BEGIN
  119.          IF MEM[$0000:$0449]=7 THEN SCREENLOCATION := $B000
  120.            ELSE SCREENLOCATION := $B800;
  121.          END;
  122.  
  123.        x_scrn := PTR(SCREENLOCATION,0);
  124.        y_scrn := PTR(SCREENLOCATION,0);
  125.  
  126.   This sets both x_scrn and y_scrn to point at the screen buffer.  The
  127.   reason for having both variables is that both variables through their
  128.   corresponding structure are optimized for optimimum access times and
  129.   code size.  As you will notice below, the procedure is really quite
  130.   simple.  If it were not for Turbo's structure capabilities, this
  131.   routine would have to go through several mathematical gymnastics to
  132.   accomplish the same thing.
  133.   ----------------------------------------------------------------------
  134.  
  135.   As with most of my other programs, this is meant to be more of an
  136.   example and a utility so that others may benefit by work previously
  137.   done.  For this reason, this code is hereby donated to Public Doman.
  138.  
  139.  
  140.   written and donated by  DAVID W. TERRY               SEPT. 1, 1985
  141.                           3036 PUTNAM CT.
  142.                           WEST VALLEY CITY, UT 84120
  143. **************************************************************************
  144. *)
  145.  
  146. TYPE
  147.   BoxType = RECORD
  148.               SIDE,WID,TOP_LE,TOP_RI,BOT_LE,BOT_RI: INTEGER;
  149.               END;
  150.  
  151. VAR
  152.   BoxChar: BoxType;
  153.   temp1,temp2,temp3,temp4,counter: INTEGER;
  154.  
  155. CONST
  156.   AllBoxChar: ARRAY[single..blank] OF BoxType =
  157.     ((SIDE:179; WID:196; TOP_LE:218; TOP_RI:191; BOT_LE:192; BOT_RI:217),
  158.      (SIDE:186; WID:205; TOP_LE:201; TOP_RI:187; BOT_LE:200; BOT_RI:188),
  159.      (SIDE:179; WID:205; TOP_LE:213; TOP_RI:184; BOT_LE:212; BOT_RI:190),
  160.      (SIDE:186; WID:196; TOP_LE:214; TOP_RI:183; BOT_LE:211; BOT_RI:189),
  161.      (SIDE:124; WID:045; TOP_LE:046; TOP_RI:046; BOT_LE:096; BOT_RI:039),
  162.      (SIDE:32;  WID:32;  TOP_LE:32;  TOP_RI:32;  BOT_LE:32;  BOT_RI:32));
  163.  
  164. BEGIN { box }
  165.   color := color ShL 8;
  166.   BoxChar := AllBoxChar[linetype];
  167.   WITH BoxChar DO BEGIN
  168.     SIDE := SIDE+color;
  169.     WID  := WID+color;
  170.     TOP_LE := TOP_LE+color;
  171.     TOP_RI := TOP_RI+color;
  172.     BOT_LE := BOT_LE+color;
  173.     BOT_RI := BOT_RI+color;
  174.  
  175.     temp1 := SUCC( PRED(y1)*80) ;
  176.     temp2 := SUCC( PRED(y2)*80) ;
  177.     temp3 := x2 + temp1 -2;
  178.     temp4 := x2 + temp2 -2;
  179.  
  180.     y_scrn^[y1,x1]   :=   TOP_LE;       { corner }
  181.     FOR counter := x1 + temp1 TO temp3 DO
  182.       x_scrn^[counter] := WID;          { horiz  }
  183.     y_scrn^[y1,x2] := TOP_RI;           { corner }
  184.     FOR counter := SUCC(y1) TO PRED(y2) DO
  185.       y_scrn^[counter,x2] := SIDE;      { vert   }
  186.     y_scrn^[y2,x2] := BOT_RI;           { corner }
  187.     FOR counter := x1 + temp2 TO temp4 DO
  188.       x_scrn^[counter] := WID;          { horiz  }
  189.     y_scrn^[y2,x1] := BOT_LE;           { corner }
  190.     FOR counter := SUCC(y1) TO PRED(y2) DO
  191.       y_scrn^[counter,x1] := SIDE;      { vert   }
  192.     END;
  193.   END;  {of Box}
  194.  
  195.  
  196. PROCEDURE Update_CurrentDir;
  197.   {Posts global CurrentDir string with the full pathname
  198.    Disk:\subdir\etc.
  199.   }
  200.   BEGIN
  201.     GetDir(0,CurrentDir);               {current drive}
  202.     len := LENGTH(CurrentDir);
  203.     IF CurrentDir[len] <> '\'           {if not just C:\}
  204.     THEN Insert('\',CurrentDir,SUCC(len)); {..then add on the \}
  205.   END;  {of Update_CurrDir}
  206.